home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib08.dsk / PIE CHARTS.bas < prev    next >
BASIC Source File  |  2023-02-26  |  7KB  |  198 lines
  1. 1  HOME : VTAB 5: HTAB 10: PRINT "GRAPHING PROGRAM 3"
  2. 2  VTAB 8: HTAB 14: PRINT "PIE CHARTS"
  3. 3  VTAB 15: HTAB 13: PRINT "R. M. SMYTHE"
  4. 5  LOMEM: 16385: HGR : POKE  -16302,0
  5. 7 :
  6. 8  REM  SET UP PROGRAM
  7. 9 :
  8. 10  IF  PEEK(768) + PEEK(769) < > PEEK(770)  THEN  GOSUB 10000: REM  INITIALIZE HRCG ON FIRST RUN
  9. 11  POKE 768,1: POKE 769,2: POKE 770,3: REM  SPECIFIC GARBAGE POKED WHERE LINE 10 CAN DETECT IT TO SKIP INITIALI-ZING ON SECOND RUN
  10. 15 FACT = .88:XC = 130:YC = 90:R = 60:PI = 3.1415926:INC = PI/190:CL =  -16336
  11. 30 M$ = "                                   "
  12. 40 S$ = "                                       "
  13. 50 FLAG = 0
  14. 60  DIM S(10),C(10),C1(10),SL(10)
  15. 70 D$ =  CHR$(4):G$ =  CHR$(7)
  16. 80  FOR I = 1 TO 10: READ C(I): NEXT : DATA  5,6,7,1,2,3,5,6,7,1
  17. 97 :
  18. 98  REM  CONTROL CHARACTERS
  19. 99 :
  20. 100 CP$ =  CHR$(16)
  21. 110 CL$ =  CHR$(12)
  22. 120 CK$ =  CHR$(11)
  23. 130 CO$ =  CHR$(15)
  24. 140 CS$ =  CHR$(19)
  25. 150 CY$ =  CHR$(25)
  26. 160 CA$ =  CHR$(1)
  27. 170 CC$ =  CHR$(3)
  28. 180 CN$ =  CHR$(14)
  29. 190 CI$ =  CHR$(9)
  30. 200 CV$ =  CHR$(22)
  31. 210 CF$ =  CHR$(6)
  32. 220 CE$ =  CHR$(5)
  33. 230 OC$ = CO$ +CC$
  34. 240 OP$ = CO$ +CP$
  35. 290  PRINT CO$,CA$: GOTO 1000
  36. 397 :
  37. 398  REM  COMPUTING PERCENTAGES
  38. 399 :
  39. 400  IF TTL = 360  THEN 420
  40. 410  FOR I = 1 TO NUM:SL(I) = SL(I)/TTL *360: NEXT 
  41. 415  REM  NOW IN DEGREES
  42. 420  FOR I = 1 TO NUM -1:S(I) = (SL(I) -SL(1)/2): NEXT 
  43. 425  REM  SLICE 1 ROTATED TO HORIZONTAL
  44. 430 S(0) =  -SL(1)/2:S(NUM) = 360 +S(0)
  45. 435  REM  SET BOTTOM OF SLICE 1 AND MAKE SURE CIRCLE CLOSES COMPLETELY
  46. 440  FOR I = 0 TO NUM:S(I) = S(I)/180 *PI: NEXT I
  47. 445  REM  NOW IN RADIANS AND SLICE 1 IS HORIZONTAL
  48. 450  RETURN 
  49. 497 :
  50. 498  REM  PLOTTING CIRCLE
  51. 499 :
  52. 500  FOR SLICE = 2 TO NUM: FOR ANGLE = S(SLICE -1) TO S(SLICE)  STEP INC: HCOLOR= C1(SLICE)
  53. 510  HPLOT XC,YC TO XC +R * COS(ANGLE),YC -R * SIN(ANGLE) *FACT
  54. 520  NEXT ANGLE,SLICE
  55. 530 X = XC +15 *HFLAG: HCOLOR= C1(1):R1 = R -8 *HFLAG: IF S(1) >.52  THEN R1 = R -3 *HFLAG:X = XC +12 *HFLAG: IF S(1) >1  THEN R1 = R:XC = XC +9 *HFLAG
  56. 535  REM  ABOVE DISPLACES SLICE 1 IF HIGHLIGHTED
  57. 540  FOR ANGLE = S(0) TO S(1)  STEP INC: HPLOT X,YC TO X +R1 * COS(ANGLE),YC -R1 * SIN(ANGLE) *FACT
  58. 550  NEXT ANGLE: RETURN 
  59. 697 :
  60. 698  REM  INPUT DATA
  61. 699 :
  62. 700  VTAB 1: PRINT CK$;"PIE CHART          DATA ENTRY"
  63. 710  PRINT "========="
  64. 720  VTAB 4: PRINT CF$;CS$;"HOW MANY SLICES IN PIE  ": PRINT : INPUT " (MAXIMUM 10)? ";A$:A =  VAL(A$): IF A <1  OR A >10  OR  INT(A) < >(A)  THEN  PRINT G$;G$;: GOTO 720
  65. 730  PRINT : PRINT CS$"ENTER DATA (POSITIVE NUMBER OR PERCENT) FOR EACH SLICE": PRINT 
  66. 740 NUM = A:TTL = 0: FOR I = 1 TO NUM
  67. 750  VTAB (10 +I): PRINT CF$;"SLICE ";I;": ";: INPUT " ";A$:SL(I) =  VAL(A$): IF SL(I) < = 0  THEN  PRINT G$;G$;: GOTO 750
  68. 760 TTL = TTL +SL(I):SL(I) = TTL: NEXT 
  69. 770  PRINT CP$;CS$;"YOUR PIE HAS ";NUM;" SECTIONS": PRINT : PRINT CS$;"YOU MAY NOW CHOOSE COLORS OR COMPUTER   WILL SELECT COLORS FOR YOU.": PRINT 
  70. 780  PRINT CK$;: INPUT "DO YOU WISH TO CHOOSE? (Y/N) ";A$: IF  LEFT$(A$,1) = "Y"  THEN 900
  71. 790  FOR I = 1 TO NUM:C1(I) = C(I): NEXT I
  72. 800  IF C1(NUM) = 5  THEN C1(NUM) = 1
  73. 810  VTAB 10: PRINT CK$;"DO YOU WISH TO HIGHLIGHT SLICE 1": INPUT "(SET IT OUT FROM THE REST - Y/N) ";A$
  74. 820 HFLAG = 0: IF  LEFT$(A$,1) = "Y"  THEN HFLAG = 1
  75. 830  RETURN 
  76. 897 :
  77. 898  REM  COLOR SELECTION
  78. 899 :
  79. 900  PRINT CP$;CS$;"SELECT FROM ";CS$;"GREEN, ";CS$;"PURPLE, ";CS$;"ORANGE, ";CS$;"BLUE,": PRINT : PRINT "OR ";CS$;"WHITE BY TOUCHING ";CK$;"G,P,O,B,";CL$;" OR ";CS$;"W."
  80. 910  PRINT CK$: FOR I = 1 TO NUM
  81. 920  VTAB (5 +I): PRINT CF$;"COLOR OF SLICE ";I;: INPUT " ";A$
  82. 930  IF A$ = "G"  THEN C1(I) = 1: GOTO 990
  83. 940  IF A$ = "P"  THEN C1(I) = 2: GOTO 990
  84. 950  IF A$ = "W"  THEN C1(I) = 3: GOTO 990
  85. 960  IF A$ = "O"  THEN C1(I) = 5: GOTO 990
  86. 970  IF A$ = "B"  THEN C1(I) = 6: GOTO 990
  87. 980  PRINT G$;G$;: GOTO 920
  88. 990  NEXT I: PRINT CP$: GOTO 810
  89. 1000  POKE 34,0: PRINT CY$;CP$: REM  CLEAR FULL SCREEN
  90. 1005  GOSUB 700: REM  INPUT DATA
  91. 1010  PRINT CP$;: GOSUB 400
  92. 1020  GOSUB 500
  93. 1070  POKE  -16368,0
  94. 1080 A =  PEEK( -16384): IF A <128  THEN 1080
  95. 1090  POKE  -16368,0
  96. 1100 A$ =  CHR$(A -128)
  97. 1110  IF A$ = "B"  THEN 1230
  98. 1120  IF A$ = "C"  THEN  GOSUB 770: PRINT CP$: GOTO 1020
  99. 1130  IF A$ = "T"  THEN 1260
  100. 1140  IF A$ = "S"  THEN 1300
  101. 1150  IF A$ = "A"  THEN 1000
  102. 1160  IF A$ = "E"  THEN  VTAB 23: END 
  103. 1165  IF A$ = "L"  THEN  GOSUB 2000: GOTO 1070
  104. 1170  FOR I = 1 TO 20: NEXT 
  105. 1180  GOTO 1080
  106. 1230 L = 35:V% = 23
  107. 1240  GOSUB 7000
  108. 1250  GOTO 1070
  109. 1260 L = 35:V% = 2: GOSUB 7000: GOTO 1070
  110. 1270 :
  111. 1280  REM  SAVE
  112. 1290 :
  113. 1300  VTAB 10: PRINT G$;G$
  114. 1310 F$ = ""
  115. 1320  POKE  -16368,0
  116. 1330 A =  PEEK( -16384): IF A <128  THEN 1330
  117. 1340  POKE  -16368,0
  118. 1350 A$ =  CHR$(A -128): IF A$ =  CHR$(13)  THEN 1380
  119. 1360  IF F$ = ""  AND (A$ <"A"  OR A$ >"Z")  THEN 1300
  120. 1370 F$ = F$ +A$: GOTO 1330
  121. 1380  IF F$ = ""  THEN 1300
  122. 1390  PRINT G$;G$;G$:F$ = "GR-" +F$
  123. 1400  PRINT D;"BSAVE";F$;",A8192,L8192"
  124. 1410  GOTO 1070
  125. 1997 :
  126. 1998  REM  PADDLE CURSOR ROUTINE
  127. 1999 :
  128. 2000  POKE  -16368,0
  129. 2010 PA =  PDL(0):PB =  PDL(1):PA =  INT(PA/255 *38 +1):PB =  INT(PB/255 *22 +1)
  130. 2020  HTAB (PA): VTAB (PB): PRINT CI$;OC$;" "
  131. 2030  FOR I = 1 TO 5: NEXT 
  132. 2040  HTAB (PA): VTAB (PB): PRINT CI$;OC$;" ";OP$;CN$
  133. 2050 B0 =  PEEK( -16287): IF B0 >127  THEN B0 = 0: GOTO 2100
  134. 2060 B1 =  PEEK( -16286): IF B1 >127  THEN B1 = 0: GOTO 2200
  135. 2080 A =  PEEK( -16384): IF A = 155  THEN  POKE  -16368,0: RETURN 
  136. 2085  IF A -128 = 76  AND PB < >24  THEN  POKE  -16368,0: GOTO 2400
  137. 2090  GOTO 2010
  138. 2100 BH(0) = (PA -1) *7 +3
  139. 2110 BV(0) = (PB) *7.95 -4
  140. 2120 X =  PEEK(CL)
  141. 2130  IF FLAG% = 2  THEN 2300
  142. 2140 FLAG% = 1: GOTO 2000
  143. 2200 BH(1) = (PA -1) *7 +3
  144. 2210 BV(1) = (PB) *7.95 -4
  145. 2230  IF FLAG% = 1  THEN 2300
  146. 2240 FLAG% = 2: GOTO 2000
  147. 2300 FLAG% = 0: HCOLOR= 3: HPLOT BH(0),BV(0) TO BH(1),BV(1)
  148. 2310  IF  PEEK( -16287) >127  OR  PEEK( -16286) >127  THEN 2310
  149. 2320  GOTO 2000
  150. 2400  HTAB (PA): VTAB (PB)
  151. 2410  GET A$: IF A$ =  CHR$(13)  THEN 2000
  152. 2420  PRINT A$;: GOTO 2410
  153. 6997 :
  154. 6998  REM  LABEL ACROSS BOTTOM
  155. 6999 :
  156. 7000 B$ =  MID$ (M$,1,L)
  157. 7010  VTAB V%
  158. 7020  GOSUB 7040
  159. 7030  RETURN 
  160. 7040 I = 1
  161. 7050 H% = 40 -L -2
  162. 7060  HTAB (H%)
  163. 7070  PRINT  MID$ (B$, LEN(B$) -L +1, LEN(B$));
  164. 7080  HTAB (H% +L)
  165. 7090  GET X$: IF X$ =  CHR$(13)  THEN 7210
  166. 7100  IF X$ < > CHR$(8)  THEN 7150
  167. 7110  IF I = 1  THEN 7060
  168. 7120 B$ =  MID$ (B$,1, LEN(B$) -1)
  169. 7130 I = I -1
  170. 7140  GOTO 7060
  171. 7150  IF I = L +1  THEN 7060
  172. 7170  IF  ASC(X$) <32  THEN 7060
  173. 7180 B$ = B$ +X$
  174. 7190 I = I +1
  175. 7200  GOTO 7060
  176. 7210 B$ =  MID$ (B$, LEN(B$) -I +2, LEN(B$))
  177. 7220 B$ = B$ + MID$ (S$,1,L - LEN(B$))
  178. 7230  PRINT 
  179. 7240  RETURN 
  180. 9997 :
  181. 9998  REM  INITIALIZE HRCG
  182. 9999 :
  183. 10000  ONERR  GOTO 10130
  184. 10010  TEXT : HOME : HGR :ADRS = 0
  185. 10020  PRINT  CHR$(4);"BLOAD RBOOT": CALL 520
  186. 10030 ADRS =  USR(0),"HRCG"
  187. 10040  POKE 216,0
  188. 10050  IF ADRS <0  THEN ADRS = ADRS +65536
  189. 10060 CS = ADRS -768: HIMEM: CS
  190. 10070 D$ =  CHR$(4)
  191. 10080  PRINT D$;"BLOAD ASCII.SET,A";CS
  192. 10090 CH =  INT(CS/256):CL = CS -CH *256
  193. 10100  POKE ADRS +7,CL: POKE ADRS +8,CH: CALL ADRS +3
  194. 10110  RETURN 
  195. 10130  TEXT 
  196. 10140  PRINT "ERROR IN RLOAD OR RBOOT"
  197. 10150  POKE 216,0
  198. 10160  STOP